unit main;

interface

uses
  Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Contnrs, SyncObjs,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ActnList, http, ComCtrls;

type
  { TfrmMain }
  TfrmMain = class(TForm)
    btnStart: TButton;
    btnQuit: TButton;
    lblNowSharing: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label3: TLabel;
    edtExternalIP: TEdit;
    edtPort: TEdit;
    Panel1: TPanel;
    lblMessage: TLabel;
    lblHttp: TLabel;
    lblBottom: TLabel;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    edtDirectory: TEdit;
    BitBtn1: TBitBtn;
    pnlDirectory: TPanel;
    BitBtn2: TBitBtn;
    memAbout: TMemo;
    TabSheet3: TTabSheet;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure edtPortKeyPress(Sender: TObject; var Key: Char);
    procedure edtExternalIPChange(Sender: TObject);
    procedure edtPortChange(Sender: TObject);
    procedure edtDirectoryChange(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure actShareExecute(Sender: TObject);
    procedure actShareUpdate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn2Click(Sender: TObject);
  private
    FDaemon: TTCPHttpDaemon;
    FConnections: TObjectList;
    procedure StartDaemon;
    procedure StopDaemon;
    procedure ChangeIpPort;
    procedure SocketEvent(AIp, AOperation, AFile: string);
  public
    { Public declarations }
  end;

  TConn = class
  private
    FText: string;
    FIp: string;
    FFile: string;
  public
    property Text: string read FText write FText;
    property IP: string read FIp write FIp;
    property FileName: string read FFile write FFile;
  end;

function GetPageControl: TPageControl; stdcall; export;

var
  frmMain: TfrmMain;

{$R *.dfm}

implementation

uses
  Windows,
  ShlObj,
  Settings,
  Clipbrd,
  getIp;


function GetPageControl: TPageControl;
begin
  Result := frmMain.PageControl1;
end;

function BrowseDialogCallBack
  (Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):
  integer stdcall;
var
  wa, rect : TRect;
  dialogPT : TPoint;
begin
  //center in work area
  if uMsg = BFFM_INITIALIZED then
  begin
    wa := Screen.WorkAreaRect;
    GetWindowRect(Wnd, Rect);
    dialogPT.X := ((wa.Right-wa.Left) div 2) -
                  ((rect.Right-rect.Left) div 2);
    dialogPT.Y := ((wa.Bottom-wa.Top) div 2) -
                  ((rect.Bottom-rect.Top) div 2);
    MoveWindow(Wnd,
               dialogPT.X,
               dialogPT.Y,
               Rect.Right - Rect.Left,
               Rect.Bottom - Rect.Top,
               True);
  end;

  Result := 0;
end;

function BrowseDialog
 (const Title: string; const Flag: integer): string;
var
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  Result:='';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  with BrowseInfo do begin
    hwndOwner := Application.Handle;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar(Title);
    ulFlags := Flag;
    lpfn := BrowseDialogCallBack;
  end;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then begin
    SHGetPathFromIDList(lpItemID, TempPath);
    Result := TempPath;
    GlobalFreePtr(lpItemID);
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  lPort: string;
  lFolder: string;
begin
  edtExternalIP.Text := GetExternalIp;
  if FileExists('.\settings.cfg') then
  begin
    ReadSettings(lPort, lFolder);
    edtPort.Text := lPort;
    edtDirectory.Text := lFolder;
  end;
  TabSheet2.PageIndex := PageControl1.PageCount - 1;

  if UpperCase(ParamStr(1)) = 'AUTOSTART' then
    actShareExecute(Self);
end;

procedure TfrmMain.edtPortKeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['0'..'9']) then
    key := #0;
end;

procedure TfrmMain.edtExternalIPChange(Sender: TObject);
begin
  ChangeIpPort;
end;

procedure TfrmMain.edtPortChange(Sender: TObject);
begin
  ChangeIpPort;
end;

procedure TfrmMain.ChangeIpPort;
begin
  lblMessage.Caption := 'Your friends must point their browsers to:';
  lblHttp.Caption := Format('http://%s:%s', [edtExternalIP.Text, edtPort.Text]);
  lblBottom.Caption := 'To see your files.';
end;

procedure TfrmMain.edtDirectoryChange(Sender: TObject);
begin
  if edtDirectory.Text = '' then
    pnlDirectory.Caption := 'Please, select the folder you want to share.'
  else
    pnlDirectory.Caption :=
      Format('Your shared folder is: %s', [edtDirectory.Text]);
end;

procedure TfrmMain.btnQuitClick(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.actShareExecute(Sender: TObject);
begin
  if btnStart.Caption = 'Stop' then
  begin
    StopDaemon;
    btnStart.Caption := 'Share!';
    lblNowSharing.Visible := False;
    exit;
  end;

  if not DirectoryExists(edtDirectory.Text) then
  begin
    MessageDlg(edtDirectory.Text + ' is not a directory',
      mtInformation, [mbOk], 0);
  end
  else
  begin
    (* save settings *)
    SaveSettings(edtPort.Text, edtDirectory.Text);
    (* start sharing *)
    btnStart.Caption := 'Stop';
    StartDaemon;
  end;
end;

procedure TfrmMain.actShareUpdate(Sender: TObject);
begin
  btnStart.Enabled := (edtPort.Text <> '') and (edtDirectory.Text <> '');
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
  lFolder: string;
begin
  lFolder := BrowseDialog('Select a folder',
                          BIF_RETURNONLYFSDIRS);

  if lFolder <> '' then
    edtDirectory.Text := lFolder;
end;


procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  StopDaemon;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageDlg('Are you sure to exit?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
  begin
    while not FDaemon.Suspended do
      FDaemon.Suspend;
    CanClose := False
  end;
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
begin
  Clipboard.SetTextBuf(PAnsiChar(edtExternalIP.Text + ':' + edtPort.Text));
end;

procedure TfrmMain.SocketEvent(AIp, AOperation, AFile: string);
var
  I: Integer;
  lFound: Boolean;
  lItem: TListItem;
  lPos: Integer;
begin
  lFound := False;
  for I := 0 to Fconnections.count - 1 do
  begin
    if TConn(FConnections[I]).Ip = AIp then
    begin
      TConn(FConnections[I]).Text := AOperation;
      lFound := True;
      if AOperation = '-1' then
        FConnections.Delete(I);
      lPos := I;
      Break;
    end;
  end;

  if AOperation <> '-1' then
  begin
    if not lFound then
      lPos := FConnections.Add(TConn.Create);
    with TConn(FConnections[lPos]) do
    begin
      IP := AIp;
      Text := AOperation;
      FileName := AFile;
    end;
  end;

  ListView1.Items.Clear;
  for I := 0 to FConnections.Count - 1 do
  begin
    lItem := ListView1.Items.Add;
    lItem.Caption := TConn(FConnections[I]).IP;
    lItem.SubItems.Add(TConn(FConnections[I]).Text);
    lItem.SubItems.Add(TConn(FConnections[I]).FileName);
  end;
  Application.ProcessMessages;
end;


procedure TfrmMain.StopDaemon;
begin
  if FDaemon <> nil then
  begin
    FDaemon.Suspend;
    FDaemon.Terminate;
    FreeAndNil(FDaemon);
    FConnections.Free;
  end;
end;

procedure TfrmMain.StartDaemon;
begin
  FDaemon := TTCPHttpDaemon.create;
  FDaemon.DllList.DrawPanels(PageControl1);
  with FDaemon do
  begin
    lblNowSharing.Visible := True;
    OnSocketEvent := SocketEvent;
    Port := edtPort.Text;
    Directory := edtDirectory.Text;
    Resume;
  end;
  FConnections := TObjectList.Create;
  FConnections.OwnsObjects := True;
end;

end.
